home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / screen.swg / 0021_Fast Direct Screen Writes.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-16  |  4.6 KB  |  150 lines
  1. (*
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 06-22-93 (23:10)             Number: 27381
  5. From: SEAN PALMER                  Refer#: NONE
  6.   To: LOU DUCHEZ                    Recvd: NO
  7. Subj: FAST DIRECT WRITES             Conf: (1221) F-PASCAL
  8. ---------------------------------------------------------------------------
  9. LD>SP>I've optimized it a little, if you're interested... 8)
  10.  
  11. LD>SP>procedure qwrite(x, y: byte; s: string; f, b: byte);
  12.  
  13. LD>Interesting optimizations -- do I assume that Inc, Dec, Pred, and Succ
  14. LD>are faster than I had ever imagined?  (Shoot, I always figured they'd be
  15. LD>a lot slower than normal arithmetic!)  Thanks!
  16.  
  17. Succ and Pred are faster for byte-sized ordinals (at least in TP 6.0)
  18. than +1 and -1. The same for word-size. See, with +1 and -1, the byte
  19. gets converted into a word first, but with Succ() and Pred() it
  20. stays a byte... Inc(I) is faster than I:=I+1 or I:=Succ(I) stuff in 6.0
  21. but I think 7.0+ optimize them all to the same code...not sure, I don't
  22. have 7.0...8(
  23.  
  24. Actually the fastest part of what I did is to pre-calculate the
  25. attribute as the hi byte of a word, and use word stores instead of byte
  26. stores. Could be done alot faster in assembly (don't access any
  27. memory-based variables that way, it's all in registers..8)
  28.  
  29. Here is a direct screen write unit I wrote in BASM. VERY fast...
  30. *)
  31.  
  32. {$A-,B-,S-,V-X+}
  33. unit Direct;
  34. interface
  35.  
  36. CONST
  37.  vSeg:word=$B800;  {change for mono}
  38.  
  39. VAR
  40.   VMode   : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }
  41.   ScrCols : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }
  42.  
  43. {in following parms, s=source,d=destination,n=count, words are offsets
  44.  into video memory (you calculate them with ((y*80+x)*2)}
  45. {I did this mainly so less parms would have to be sent, as TP does a
  46.  good job of the arithmetic for that expression...Oh well if you really
  47.  don't like it I could make these use x and y coords, but this was
  48.  basically chopped from another project of mine..}
  49.  
  50. procedure moveScr(s,d,n:word);    {one part of screen to another}
  51. procedure toScr(var s;d,n:word);  {from string to video ram}
  52. procedure toScrA(var s;d,n:word;a:byte); {ditto with attribute also}
  53. procedure fillScr(d,n:word;c:char);      {mainly useful for rows}
  54. procedure fillAttr(d,n:word;a:byte);     {ditto}
  55.  
  56. { I added the following to make this GREAT code more useful for us hackers !!}
  57. { Gayle Davis 06/26/93 }
  58.  
  59. function  ScreenAdr (Row,Col : Byte) : WORD;
  60. procedure Qwrite(Row, Col, Attr: byte; S: string);
  61.  
  62. implementation
  63.  
  64.  
  65. procedure moveScr(s,d,n:word);assembler;asm
  66.  mov cx,n; jcxz @X;
  67.  push ds; mov ax,vSeg; mov es,ax; mov ds,ax;
  68.  mov si,s; shl si,1;
  69.  mov di,d; shl di,1;
  70.  cmp si,di; jb @REV;  {move in reverse to prevent overwrite}
  71.  cld; jmp @GO;
  72. @REV: std; shl cx,1; add si,cx; add di,cx; shr cx,1; {start at end}
  73. @GO: repz movsw; {move attr too!}
  74.  pop ds;
  75. @X:
  76.  end;
  77.  
  78. procedure toScr(var s;d,n:word);assembler;asm
  79.  mov cx,n; jcxz @X;
  80.  push ds; mov es,vSeg;
  81.  mov di,d; shl di,1;
  82.  lds si,s; cld;
  83. @L: movsb; inc di; loop @L;
  84.  pop ds;
  85. @X:
  86.  end;
  87.  
  88. procedure toScrA(var s;d,n:word;a:byte);assembler;asm
  89.  mov cx,n; jcxz @X;
  90.  push ds; mov es,vSeg;
  91.  mov di,d; shl di,1;
  92.  lds si,s; cld;
  93.  mov al,a;  {attribute}
  94. @L: movsb; {doesn't affect al reg}
  95.  stosb; loop @L;
  96.  pop ds;
  97. @X:
  98.  end;
  99.  
  100. procedure fillScr(d,n:word;c:char);assembler;asm
  101.  mov cx,n; jcxz @X;
  102.  mov es,vSeg;
  103.  mov di,d; shl di,1;
  104.  mov al,c; cld;
  105. @L: stosb; inc di; loop @L;
  106. @X:
  107.  end;
  108.  
  109. procedure fillAttr(d,n:word;a:byte);assembler;asm
  110.  mov cx,n; jcxz @X;
  111.  mov es,vSeg;
  112.  mov di,d; shl di,1;
  113.  mov al,a; cld;
  114. @L: inc di; stosb; loop @L;
  115. @X:
  116.  end;
  117.  
  118. function ScreenAdr (Row,Col : Byte) : WORD;
  119. BEGIN
  120.    ScreenAdr := PRED (Row) * ScrCols + PRED (Col) * 2;
  121. END;
  122.  
  123. procedure qwrite(Row, Col, Attr: byte; S: string);
  124. BEGIN
  125. toScrA(MemW[Seg(S):SUCC(Ofs(S))], ScreenAdr(Row,Col), Length(S), Attr);
  126. END;
  127.  
  128. BEGIN
  129. IF VMode = 7 Then VSeg := $B000;
  130. END.
  131.  
  132.  
  133.  
  134. Keep in mind these are VERY low-level and aren't necessarily gonna be
  135. easy to work with but they are, by god, FAST.
  136.  
  137. LD>As to why I pass attributes and don't use WhereX() and WhereY(), I wrote
  138. LD>QWRITE mostly for screen drawing -- in fact, QWRITE doesn't even move the
  139. LD>cursor.  It's no good for "scrolling" text, but goldang, when you want
  140. LD>to draw a box on the screen or fill a region with a given character ...
  141.  
  142. These don't either (cursor? who needs it!)
  143.  
  144. QWrite'll work a little faster now, anyway...
  145.  
  146.  * OLX 2.2 * Cana-DOS: "Yer sure, eh?" [O]k, eh! [N]o way! [B]eauty! ?
  147.  
  148. --- Maximus 2.01wb
  149.  * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)
  150.